home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 2 / Atari Mega Archive CD - Volume 2.iso / 8bit / cislib_a / loadpt.act < prev    next >
Text File  |  1995-04-22  |  4KB  |  149 lines
  1. ; LOaDPT 9/84-4/28/85, A. B. Langdon
  2.  
  3. ; Read executable file to see where
  4. ; its segments load and its entry point(s) are.
  5.  
  6. SET $491=$4000 SET 14=$491^
  7. BYTE rts=[$60] ;
  8. ;INCLUDE "D:SYSLIB.ACT"
  9. ;INCLUDE "D:SYSIO.ACT"
  10.  
  11. ; Using channel 1, Close caused "system error" with DOS 2.1 but not DOS XL.
  12. ; ACS bbs has a block read (BLKIO.ACT) in machine code segments that is
  13. ; smaller and has a general purpose call to CIO. Here, I'll leave mine
  14. ; as it illustrates use of the language and is just as fast.
  15.  
  16. ; First global ARRAY, other than BYTE ARRAY of length less than 257,
  17. ; is placed AFTER rest of program (undocumented?).
  18. BYTE ARRAY buffer(257)   ; locate the buffer.
  19.  
  20. CARD FLen, ; File length up to 64K
  21.      i, CSum
  22. BYTE OpOK, CSum0=CSum, CSum1=CSum+1
  23.  
  24. BYTE CIO_status ; global for CIO return value (per ACS convention)
  25.  
  26. CARD FUNC GetAD(BYTE chan CARD addr, len) ; Block read
  27.   TYPE IOCB=[BYTE hid,dno,com,sta
  28.              CARD badr,put,blen
  29.              BYTE aux1,aux2,aux3,aux4,aux5,aux6]
  30.   IOCB POINTER ic
  31.   BYTE chan16
  32.   BYTE POINTER b
  33.   chan16 = (chan&$07) LSH 4
  34.   ic = $340+chan16
  35.   ic.com = 7 ; read
  36.   ic.blen = len
  37.   ic.badr = addr
  38.   [$AE chan16 $20 $E456 $8C CIO_status] ; LDX chan, JSR CIO; STY CIO_status
  39.   IF CIO_status = $88 THEN EOF(chan)=1 FI
  40.   FLen ==+ ic.blen  ; this to RETURN is special to this application.
  41.   b = addr
  42.   FOR i = 1 TO ic.blen DO
  43.     CSum0 ==+ b^
  44.     CSum1 ==+ CSum0
  45.     b ==+ 1
  46.   OD
  47. RETURN (ic.blen)
  48.  
  49. CARD FUNC GetCD(BYTE chan) ; Read a word
  50.   CARD c
  51.   GetAD(chan,@c,2)
  52. RETURN (c)
  53.  
  54. PROC FixFlSp(BYTE ARRAY FileSpec)
  55.   IF FileSpec(2)<>': AND FileSpec(3)<>': THEN ; prefix "D:" to file name
  56.     FileSpec^==+2
  57.     i=FileSpec^
  58.     WHILE i>2 DO
  59.       FileSpec(i)=FileSpec(i-2)
  60.       i==-1
  61.     OD
  62.     FileSpec(1)='D  FileSpec(2)=':
  63.   FI
  64. ; Could also convert to upper case: if >$60 then subtract $20.
  65. RETURN
  66.  
  67. PROC SysErr(BYTE errno)
  68.  
  69. PROC MyError(BYTE errno)
  70.   IF errno=$80 THEN Error=SysErr Error(errno) FI
  71.   PrintF("error %I. Try again%E",errno)
  72.   OpOK=0
  73. RETURN
  74.  
  75. PROC End=*() [$68$AA$68$CD$2E8$90$5$CD$2E6$90$F3 $48$8A$48$60]
  76. ; entry: PLA; TAX; PLA; CMP MEMLO+1; BCC lab; CMP MEMTOP+1; BCC entry;
  77. ; lab: PHA; TXA; PHA; RTS
  78. ; Trace back thru RTS's and return to cartridge or DOS.
  79. ; From ACS bulletin board.
  80.  
  81. PROC LoadPt()
  82.   CHAR ARRAY FileSpec(20)
  83.   BYTE b, SHFLOK=$2BE
  84.   CARD fwa, lwa, BufLen, MEMTOP=$2E5, MEMLO=$2E7
  85.   BufLen=MEMTOP-$80-buffer
  86.   SysErr=Error
  87.   DO
  88.     Print("File Spec=")
  89.     SHFLOK=$40 ; upper case
  90.     InputS(FileSpec)
  91.     IF FileSpec^=0 THEN END() FI
  92.     FixFlSp(FileSpec)
  93.     Close(2)
  94.     OpOK=1 Error=MyError Open(2,FileSpec,4,0)
  95.   UNTIL OpOK OD
  96.   Error=SysErr
  97.   FLen=0 CSum0=0 CSum1=0
  98.  
  99.   i=GetCD(2)
  100.   IF i<>$FFFF THEN ; is it a LOAD file?
  101.     PrintF("Bad load file header=%H%E",i)
  102.     Close(2)
  103.     RETURN
  104.   FI
  105.  
  106.   DO; Code block
  107.     DO
  108.       fwa=GetCD(2)
  109.       IF fwa=0 THEN ; may get 0 before EOF in DOS 4.
  110.         FLen==-2  CSum1==-CSum0-CSum0 ; ignore these 2 bytes
  111.         EOF(2)=1
  112.       FI
  113.       IF EOF(2)<>0 THEN
  114.         PrintF("End of file. %H bytes%E",FLen)
  115.         PrintF(" checksum=%H%E",CSum)
  116.         Close(2)
  117.         RETURN
  118.       FI
  119.     UNTIL fwa<>$FFFF OD; Skip embedded $FFFF
  120.     lwa=GetCD(2)
  121.     IF (fwa=$2E2 OR fwa=$2E0) AND lwa=fwa+1 THEN
  122.       IF fwa=$2E0 THEN Print("INIT")
  123.                   ELSE Print("RUN") FI
  124.       i=GetCD(2)
  125.       fwa==+2
  126.       PrintF(" at %H%E",i)
  127.     ELSE
  128.       PrintF("fwa, lwa %H %H%E",fwa,lwa)
  129.       IF fwa<MEMLO AND lwa>$700 THEN
  130.         PrintF("ACHTUNG! This loads into%Eyour DOS (MEMLO=%H)%E",MEMLO)
  131.       FI
  132.     FI
  133.     WHILE lwa>=fwa DO ; just pass over these bytes
  134.       i=lwa-fwa+1 IF i>BufLen THEN i=BufLen FI
  135.       i=GetAD(2,buffer,i)
  136.       fwa==+i
  137.     OD
  138.   OD
  139.   Close(2)
  140. RETURN
  141.  
  142. PROC Main()
  143.   device=0 ; in case MAC/65 has been here
  144.   DO
  145.     LoadPt()
  146.     PrintE(" (RETURN to end)")
  147.   OD
  148. RETURN
  149. iiiiiiiiiiiiiiiiiiiiiii